perm filename FAIL[MSS,LCS] blob
sn#179209 filedate 1975-09-28 generic text, type T, neo UTF8
13000 DBAR: 0 ; CALL DBAR(K,ITEM,J)
14100 MOVE 4,@2(16) ; -J-RR=RN(J+3)
14150 MOVE 7,XRN+2(4) ; -RR-
14200 MOVE 4,@(16) ; DO 82 KY=K+1,ITEM
14300 DB: MOVE 5,PTR(4) ;KZ=PWDS(KY)
14350 FIXX(5) ; -KY-
14400 MOVE 6,XRN(5) ; IF(RN(KZ+1).NE.4)GO TO 82
14450 CAME 6,[4.0]
14460 JRST DB82
14500 MOVE 6,XRN-1(5) ;IF(RN(KZ).NE.2)GO TO 82
14510 CAME 6,[2.0]
14520 JRST DB82
14600 ;;C AVOIDS DUPLICATE BARS.
14700 MOVN 6,XRN+2(5) ;IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82
14710 FADR 6,7
14720 SKIPGE 6
14730 MOVNS 6
14740 CAMLE 6,[0.5]
14750 JRST DB82
14800 MOVE 6,[99.0] ;RN(KZ+2)=99
14810 MOVE 6,XRN+1(5)
14900 SETZM XRN(5) ;RN(KZ+1)=0
15000 DB82: AOJ 4, ;82 CONTINUE
15010 CAME 4,@1(16)
15020 JRST DB
15030 JRA 16,3(16)
15040
15100 IF(YN.NE.'Y')GO TO 810
15200 CALL ADDRST(RR,XWDS,PN)
15300 GO TO 6
15400 182 RN(J+1)=44
15500 C CHANGES CODE NUM
15600 IF(RN(J).LT.5)GO TO 80
15700 IF(RN(J+7).GE.3)GO TO 6
15800 C SKIP HEAVY BRACKETS.
15900 80 RSN=RN(J+2)
16000 C THE STAFF NUM.
16100 CC80 IF(RN(J+2).NE.SN)GO TO 6
16200 IF(R.NE.3)GO TO 3801
16300 IF(YCLEF)GO TO 4801
16400 IF(RSN.NE.SN)GO TO 6
16500 4801 RR=RN(J+5)
16600 IF(RN(J).LT.3)RR=0
16700 IF(RR.EQ.CLEF)GO TO 6
16800 C SKIP DUPLICATE CLEFS.
16900 IF(RR.GT.3)GO TO 4800
17000 CLEF=RR
17100 C** IF(YCLEF.EQ.1)GO TO 4802
17200 C** IF(YCLEF)YCLEF=1.
17300 YCLEF=0
17400 GO TO 1800
17500 4800 IF(RSN.NE.SN)GO TO 6
17600 RN(J+1)=33
17700 GO TO 1800
17800 4802 YCLEF=0
17900 C CATCHES CLEF AFTER FIRST RESTS.
18000 GO TO 6
18100 3801 IF(R.NE.17)GO TO 3800
18200 IF(YSIG)GO TO 3802
18300 IF(RSN.NE.SN)GO TO 6
18400 3802 IF(RN(J+5).EQ.XSIG)GO TO 6
18500 YSIG=0
18600 XSIG=RN(J+5)
18700 C SKIPS DUPL. KEY SIGS.
18800 GO TO 1800
18900 3800 IF(R.EQ.8)GO TO 6
19000 C OMIT ALL STAVES FOR NOW
19100 IF(R.NE.18.)GO TO 81
19200 IF(YMTR)GO TO 1801
19300 IF(RSN.NE.SN)GO TO 6
19400 1801 RA=RN(J+5)*100.+RN(J+6)
19500 C THE TIME SIG.
19600 IF(XMTR.EQ.RA)GO TO 6
19700 XMTR=RA
19800 YMTR=0
19900 GO TO 1800
20000 81 IF(RSN.NE.SN)GO TO 6
20100 1800 IF(RN(J+3).LT.XLFT)GO TO 6
20200 C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
20300 810 JA=PWDS(K+1)
20400 RN(J+2)=RS
20500 DO 7 KY=J,JA-1
20600 PN(LK)=RN(KY)
20700 7 LK=LK+1
20800 L=L+1
20900 XWDS(L)=LK
21000 6 CONTINUE
21100
21200 C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
21300 I=1
21400 DO 243 K=1,L-1
21500 LB=XWDS(K)+1
21600 IF(PN(LB).NE.16)GO TO 243
21700 IF(PN(LB-1).LT.8)GO TO 243
21800 JL=XWDS(K-1)
21900 244 PN(LB+2)=PN(JL+3)
22000 C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
22100 C FOR SPACING PROBLEMS BELOW.
22200 243 CONTINUE
22300 M=2
22400 J=1
22500 24 RA=100000.
22600 C POSITION
22700 DO 21 K=1,L-1
22800 JL=XWDS(K)+3
22900 R=PN(JL)
23000 IF(R.EQ.100000)GO TO 21
23100 241 IF(ABS(R-RA).GT..1)GO TO 240
23200 R=RA
23300 PN(JL)=R
23400 C PUT IN HERE MULTI-VOICE TRAP
23500 GO TO 21
23600 240 IF(R.GT.RA)GO TO 21
23700 C LINES THEM UP
23800 I=K
23900 RA=R
24000 21 CONTINUE
24100 IF(RA.EQ.100000)GO TO 23
24200 C JUMP IF ALL SORTED
24300 242 JL=XWDS(I)
24400 LA=JL
24500 N=PN(JL)+3
24600 C NEXT POINTER
24700 PWDS(M)=PWDS(M-1)+N
24800 M=M+1
24900 DO 22 K=J,J+N-1
25000 RN(K)=PN(JL)
25100 22 JL=JL+1
25200 PN(LA+3)=100000
25300 C PUT IT ASIDE
25400 J=N+J
25500 GO TO 24
25600
25700 23 IF(ENDLN.EQ.0)GO TO 2334
25800 R4=0
25900 R5=1000
26000 R7=RS
26100 R8=ENDLN
26200 R9=0
26300 GO TO 33
26400 2334 R4=0
26500 R5=10000
26600 CC R8=-XLFT
26700 R8=1.-RN(4)
26800 R9=0
26900 C INSERT?? →→ IF(R8.GT.0)R9=200.
27000 R7=RS
27100 33 CALL PTMOVE(RN,PWDS)
27200 DO 32 K=1,IFIX(PWDS(L))-1
27300 KQ=KQ+1
27400 32 Q(KQ)=RN(K)
27500 ENDLN=ENDLN+200
27600 L=1
27700 LK=1
27800 TYPE 3001,KQ
27900 GO TO 10
28000
28100 27 FORMAT(' RESPACING')
28200 20 K=1
28300 TYPE 27
28400 KK=1
28500 220 JJ=Q(K)+3
28600 PN(KK)=K
28700 C NEW POINTER
28800 K=K+JJ
28900 KK=KK+1
29000 IF(K.LT.KQ)GO TO 220
29100 PN(KK)=K
29200 TYPE 3001,KK
29300 L=KK
29400 C DELETES EXTRA BAR LINES, ETC.
29500 CALL RESTS(PN,Q)
29600 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
29700 K=1
29800 L=1
29900 LL=0
30000 LK=1
30100 221 IF(Q(IFIX(PN(K))+1))GO TO 321
30200 DO 421 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
30300 LL=LL+1
30400 421 Q(LL)=Q(KL)
30500 LK=LK+1
30600 PN(LK)=LL+1
30700 321 K=K+1
30800 IF(K.LT.KK)GO TO 221
30900 L=LK-1
31000 C L=NUMBER OF ITEMS FOR RHY RECONS.
31100 123 LB=1
31200 LL=0
31300 R5X=0
31400 C NEXT RECONSTITUTES RHYTHM
31500 LP=1
31600 25 N=PN(LB)
31700 R=Q(N+1)
31800 IF(TR.EQ.0)GO TO 51
31900 IF(R.EQ.1)GO TO 52
32000 IF(R.EQ.5)GO TO 52
32100 IF(R.EQ.6)GO TO 52
32200 IF(R.EQ.17)GO TO 117
32300 51 PR=0
32400 IF(R.LE.4)GO TO 430
32500 IF(R.LT.17)GO TO 30
32600 C LOOKS FOR 17 AND 18, KSIG AND METER.
32700 IF(R.GT.18)GO TO 30
32800 430 IF(R.NE.1)GO TO 230
32900 IF(Q(N).LT.7)GO TO 630
33000 IF(Q(N+9))GO TO 30
33100 C SKIPS NON-LEDGER LINE NOTES.
33200 GO TO 130
33300 630 PR=1.
33400 IF(Q(N+8).EQ.1000.)PR=.05
33500 C ↑↑↑↑ FOR GRACE NOTES
33600 GO TO 130
33700 C LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS, AND BARS,CLEFS
33800 230 IF(R.NE.2)GO TO 130
33900 IF(Q(N).LT.5)PR=1.
34000 C JUMP IF NO RHYTH VALUE FOUND IN P7 (P9 FOR NOTES)
34100 CC130 IF(RCLEF(Q(N)))GO TO 30
34200 CJ SKIPS NON-CLEFS
34300 130 S=Q(N+3)
34400 LA=LB
34500 26 LA=LA+1
34600 IF(LA.GT.L)GO TO 30
34700 C FIND NEXT IMPORTANT ITEM
34800 NA=PN(LA)
34900 RR=Q(NA+1)
35000 IF(RR.LE.4)GO TO 134
35100 IF(RR.LT.17)GO TO 26
35200 IF(RR.GT.18)GO TO 26
35300 CC134 IF(RR.NE.4)GO TO 34
35400 CC IF(Q(NA).NE.2)GO TO 26
35500 C USES ONLY NOTES, RESTS, BARS, CLEFS
35600 CC34 IF(RCLEF(Q(NA)))GO TO 26
35700 CJ SKIPS NON-CLEFS
35800 134 RX=Q(NA+3)
35900 C POSITION OF NEXT ITEM
36000 IF(S.EQ.RX)GO TO 26
36100 IF(R.LT.3)GO TO 235
36200 IF(R.GE.17)P=4.
36300 C PUT IN FOR LARGE KSIGS LATER.
36400 IF(R.EQ.4)P=2.
36500 IF(R.EQ.3)P=6.
36600 IF(Q(NA+5).GE.100.)P=5.
36700 C SPACE FOR BARS, KSIG, METERS, CLEFS (LAST FOR MINI-CLEF)
36800 IF(RR.EQ.17)P=P+3.
36900 C IF NEXT(RR) IS KSIG, ADD SPACE.
37000 GO TO 335
37100 235 K=9
37200 IF(R.EQ.2)K=7
37300 P=Q(N+K)
37400 IF(PR.NE.0)P=PR
37500 C ASSUMES QUARTER VALUE IF NONE WAS GIVEN
37600 P=P+(.125-P)*FIB
37700 135 P=P*RSPC
37800 C FINDS RHYTH IN P9 OR P7(REST)
37900 C IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
38000 IF(P)GO TO 30
38100 C SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
38200 335 SX=S+P-RX
38300 R5X=R5X+SX
38400 C SPACE DIFFERENCE
38500
38600 R7=RS
38700 IF(SX.LT.-.5)GO TO 29
38800 IF(SX.LT.0.5)GO TO 30
38900 2900 R4=RX
39000 R5=10000.
39100 R8=SX
39200 R9=0
39300 C ADJUST REST OF LINE
39400 CALL PTMOVE(Q,PN)
39500 IF(SX)GO TO 30
39600 29 R4=S
39700 R5=RX
39800 R8=S
39900 R9=RX+SX
40000 C ADJUST STUFF BETWEEN POINTS
40100 CALL PTMOVE(Q,PN)
40200 IF(SX)GO TO 2900
40300
40400 30 LB=LB+1
40500 IF(LB.LT.L)GO TO 25
40600 C GO BACK IF MORE SPACING TO DO
40700 C*** IF(XLFT.EQ.0)GO TO 600
40800 C NEXT MOVES LEFT SIDE OF STAFF TO ZERO
40900 CC R5=10000.
41000 CC R7=RS
41100 CC R8=-XLFT
41200 CC R4=-101
41300 CC R9=0
41400 CC CALL PTMOVE(Q,PN)
41500 C*** CALL LINELN
41600 C BREAKS IT UP INTO LINES.
41700 J=1
41800 CALL OFILE(1,'PX')
41900 LL=PN(L+1)
42000 2929 WRITE(1),L,LL,
42100 1(PN(K),K=1,L+1),(Q(K),K=1,LL-1),NAMX,STFSZ,J,J,RSTFAC,STFF,IV,STFF
42200 STOP
42300 2 FORMAT(A5)
42400 3001 FORMAT(2I6)
42500 5 FORMAT(5F)
42600
42700
42800 52 A=Q(N+4)
42900 Q(N+4)=A+TR
43000 C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
43100 X=Q(N+5)
43200 IF(Q(N+1).EQ.1)GO TO 11
43300 C COULD ADD STEM REVERSE HERE.
43400 Q(N+5)=X+TR
43500 GO TO 51
43600 11 A=AMOD(A,100.)
43700 IF(TR.NE.4)GO TO 1101
43800 IF(AMOD(A,7.0).EQ.0)GO TO 101
43900 1101 IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
44000 C NEXT IS FOR Bb TRANSP.
44100 B=AMOD(A+7.0,7.0)
44200 IF(B.EQ.0)GO TO 101
44300 IF(B.NE.3)GO TO 51
44400 C FINDS ORIG. E OR B
44500 101 M=AMOD(X,10.0)
44600 C FINDS ACCID.
44700 X=X-M
44800 C STEM DIR. AND DECI.
44900 B=3.
45000 C CHANGES FLAT TO NATURAL SIGN.
45100 IF(M.NE.0)GO TO 118
45200 IF(SIG.NE.200)GO TO 51
45300 C GO BACK IF A KEY SIG. IS PRESENT
45400 118 IF(M.EQ.3)B=2
45500 C NO PROVISION YET FOR ## OR bb
45600 2101 Q(N+5)=X+B
45700 GO TO 51
45800 117 SIG=Q(N+5)
45900 IF(TR.EQ.1)SIG=SIG+2
46000 IF(TR.EQ.4)SIG=SIG+1
46100 C CHANGE KSIG FOR Bb AND F INSTS. ADD CHECK-UP ABOVE LATER.
46200 C MAKES NATURALS IF CHANGED TO NO KSIG (I.E. =0)
46300 IF(SIG.NE.0)GO TO 217
46400 IF(TR.EQ.1)SIG=-102
46500 IF(TR.EQ.3)SIG=-101
46600 217 Q(N+5)=SIG
46700 GO TO 51
46800 END